perm filename PARSE[X,AIL]3 blob
sn#081251 filedate 1974-01-18 generic text, type T, neo UTF8
COMMENT ⊗ VALID 00022 PAGES VERSION 17-1(13)
RECORD PAGE DESCRIPTION
00001 00001
00003 00002 HISTORY
00006 00003 Parser Description
00011 00004 Parse Data
00014 00005 Parser Routine -- Crank Up
00017 00006 Compare Loop
00019 00007 Pop to Temps, Do Execs
00023 00008 Restore Stack, Scan
00028 00009 Timer Package
00032 00010
00035 00011
00037 00012 Debugging Package -- Description
00042 00013 Variables
00049 00014 Stplin -- Break on <crlf>
00050 00015 Dmyexc, etc. -- Main Control Loops
00053 00016 Dmy -- Inna, Inn --Display Subroutine
00057 00017
00058 00018 Read L/P
00061 00019 Ddtg, Rego, Proxx -- Enter, Leave DDT, Proceed from Debug
00063 00020 Prinlin -- Print Stack Entry Line
00065 00021
00069 00022 Decfil, Ascfil, Prinsym
00073 ENDMK
⊗;
COMMENT ⊗HISTORY
AUTHOR,REASON
021 102100000015 ⊗;
COMMENT ⊗
VERSION 17-1(13) 1-11-74 BY JRL CMU CHANGE
VERSION 17-1(12) 12-6-73 BY JRL REMOVE STANFORD SPECIAL CHARACTERS
VERSION 17-1(11) 12-3-73 BY RHT TURN CALL INTO A CALL6 (P 16)
VERSION 17-1(10) 12-3-73
VERSION 17-1(9) 11-14-73 BY jrl let debugging package know about lower case (1m etc)
VERSION 17-1(8) 11-10-73 BY KVL MOVE PRSYM HERE (FROM SOME TRUELY ODD PLACE)
VERSION 17-1(7) 11-10-73
VERSION 17-1(6) 11-10-73
VERSION 17-1(5) 11-10-73
VERSION 17-1(4) 9-19-73 BY HJS ADD EVALREDFINE AND CVPS
VERSION 17-1(3) 8-27-73 BY JRL INCREASE SIZE OF DDFPDP FOR DEBUGGER
VERSION 17-1(2) 8-27-73 BY JRL FORCE DDFIND TO SAVE LPSA,TEMP,USER
VERSION 17-1(1) 7-26-73 BY RHT JUST CHECKING
VERSION 17-1(0) 7-26-73 BY RHT **** VERSION 17 ****
VERSION 16-2(32) 8-25-72 BY KVL TO MAKE CERTAIN PARSE TOKENS AVAILABLE GLOBALLY
VERSION 16-2(31) 7-3-72 BY DCS MANY FIXES, INSTALL VERSION 16
VERSION 15-2(18-30) 6-13-72 RANDOMNESS
VERSION 15-2(17) 2-26-72 BY DCS ADD (PRO,EXC,SCN,LIN)CNT COUNTERS
VERSION 15-2(10) 2-21-72 BY HJS THE BRAVE NEW PARSER WORLD
VERSION 15-2(9) 2-10-72 BY DCS BUG #GR# DO MINOR THINGS TO FTDEBUGGER
VERSION 15-2(8) 2-5-72 BY DCS BUG #GJ# ADD LSTON LISTING CONTROL STUFF
VERSION 15-2(7) 2-1-72 BY DCS BUG #GH# 6M IS SCANNER BREAK, <ESC> I INTERRUPTS STATT CR
VERSION 15-2(6) 2-1-72 BY DCS BUG #GG# Lnnnnn is Lnnnnn/. in FTDEBUGger
VERSION 15-2(5) 2-1-72 BY DCS LPSTOP FROM USER TABLE TO COMPILER
VERSION 15-2(4) 12-26-71 BY DCS BUG #FU# REENABLE ACCESS TO FTDEBUGGER FROM ERR STUFF
VERSION 15-2(3) 12-22-71 BY DCS BUG #FT# GET PRINSYM OUT OF FTDEBUG (MYERR CALLS)
VERSION 15-2(2) 12-2-71 BY DCS INSTALL VERSION NUMBER
⊗;
COMMENT ⊗Parser Description⊗
LSTON (PARSE)
BIT2DATA (PARSE TOKEN CLASS/OPERATOR BITS)
?CLSIDX←←11
?OPER←←0⊗=18 ;HIGH ORDER BIT FOR RESERVED WORD SYMBOL TABLE
?CLASOP←←OPER+CLSIDX⊗=18 ;SAME, BUT FOR CLASS MEMBERS
ENDDATA
BEGIN PARSE
DSCR PARSE --- Sail's production interpreter.
DES
This is the production interpreter for the SAIL
language. It is table driven, by tables organized
as follows. Each production is represented by an entry:
1. (optional name in ascii -- if bit 35 is on,
signal the debugging package)
2. xwd [where to go if compare FAILS],[where if SUCCEEDS]
3. --ID numbers, etc. stored in 12 bit bytes.
4. address of production to "pushj" to (optional).
The interpreter has 5 parts. The five operations are
performed in series. The last four are executed
only if the first one (the compares on the parse stack)
succeeds. The parts are:
1. Compare the parse stack with the ID numbers stored
in the 12 bit bytes. The types of compares and
depth are determined by bits in the byte--
The operations performed are:
<no bits> compare ID number against stack
bclass Compare class of stack element to ID class
bcare Careful compare -- ignore class information.
bdone Done -- go on to part 2.
If the compares fail before reaching the "done"
indication, the interpreter transfers its attention
to the production named in the "FAIL" location.
2. Pop the parse stack elements which are involved in
the current production.
The top element is put in PARLEF, the
next in PARLEF+1, etc. The generator stack
entries are popped (in synchronism) into temporaries
GENLEF, GENLEF+1, etc.
3. Restore the stacks. The bytes are examined
as above, starting where step 3 left off.
The stacks are not actually restored at this time.
Instead, the right half temporaries PARRIG and GENRIG
are composed from information in the bytes:
btemp Restore the temporary pointed to by the
12 bit byte.
<no bits> Use the byte as immediate information for
the parse stack.
bdone Done -- go to step 4.
4. Call the necessary executive routine. The bytes
are examined
<no bits> Executive routine. Use 12 bit byte as index
into EXCTAB.
bclass Executive routine appropriate to class.
Pick up the parse stack temporary
pointed to by the current 12 bit byte. Pick up next
byte and subtract from first (this gives us
a RELATIVE base). Then get the next 12 bit byte, and
use it as index into EXCTAB for the routine
to call.
bdone Done -- go to step 5.
5. Scan. The byte is the number of times to call the
scanner.
6. This last byte (the one which specified the number of scans)
may also indicate a production pushj or popj.
bclass pushj to the location specified in the next
full word in the production tables.
bcare popj.
The interpreter is called by:
PUSH P,[PRODGO]
JRST PARSE
⊗;
DEFINE SUBR (X) <PUSHJ P,X>
COMMENT ⊗Parse Data⊗
;DECLARATIONS FOR ACCUMULATORS
ACDATA (PARSER)
PP←←SP
GP←←7
PROD←←10
PTR←←12
ZERODATA (PARSER VARIABLES)
?FTCOUNT←←0
IFN FTCOUNT <
?CARCNT: 0 ;COUNT OF NUMBER OF CAREFUL COMPARES
?CLSCNT: 0 ;COUNT OF NUMBER OF CLASS COMPARES
?REGCNT: 0 ;COUNT OF NUMBER OF REGULAR COMPARES
>;IFN FTCOUNT
;SAVPAR, SAVPOP, SAVSEM, TEMCNT -- temporaries for the PARSER
↑SAVPAR: 0
↑SAVPOP: 0
↑SAVSEM: 0
?TEMCNT: 0
TABCONDATA (PARSER BIT TABLE)
; BIT TABLE FOR CLASS OPERATIONS -- GAIN SPEED OVER CALCULATING THEM
?BITAB:
FOR I←0,=35 <
1 ⊗ I >
DATA (PARSER PARSE TOKENS)
COMMENT ⊗
These variables allow access to PARSE token numbers, for use by
EXECS when they have to examine or change the PARSE stack -- for
example, TRAGO must search the PARSE stack to generate code
for leaving blocks, loops, etc.
⊗
↑%NSP: NSP
↑%NIP: NIP
↑%ASSDO: NASSDO & 777
↑%DOL: NDOL & 777
↑%NBEG: RBEGIN & 777
↑%PDNO: NPDNO & 777
↑%NFORC: NFORCA & 777
↑%NPDEC: NPDEC & 777
↑%OPC: NOPC & 777 ;OPCODE, SET BY SETSIZ (GENERATOR)
↑%WHILC: NWHILC & 777
↑%CTRU1: CLASOP+NCTRU1
↑%CFLS1: CLASOP+NCFLS1
↑%EOFILE: NEOFILE & 777
↑%BLKFRC: NBLKFRC & 777
↑%NBLAT: NBLAT & 777
↑%MPRO: NMPRO & 777
↑%ILB: TILB & 777
↑%ISV: TISV & 777
↑%ARID: NARID & 777
↑%PCALL: NPCALL & 777
↑%FCALL: NFCALL & 777
↑%S: NS & 777
↑%ITV: TITV & 777
ENDDATA
COMMENT ⊗Parser Routine -- Crank Up⊗
;DECLARATIONS OF CONTROL BITS IN PRODUCTION BYTES.
BITDATA (PARSER CONTROL)
BCLASS←← 4000 ;CONTROL BITS IN 12 BIT BYTE.
BTEMP ←← 2000
BCARE ←← 2000 ;MUST BE SAME AS BTEMP
BDONE ←← 1000 ;DONE WITH THIS "PHASE"
BPRESUME ←← 400
ENDDATA
↑CPRODGO: Q117 ; PRODUCTION TO START "OTHER" PARSER
↑PRODGO: BB0 ;PRODUCTION WITH WHICH TO START
↑PROCON: IF0 ; PRODUCTION TO START COND. ASSEMBLY
WH0 ; PRODUCTION TO START WHILEC
CS0 ; PRODUCTION TO START CASEC
FR0 ; PRODUCTION TO START FORC
FL0 ; PRODUCTION TO START FORLC
DF0 ; PRODUCTION TO START DEFINE
IF5 ; PRODUCTION TO START IFC WITH NO MACRO
; EXPANSION IN THE FALSE PART
RDF ; PRODUCTION TO START REDEFINE
EDF ; PRODUCTION TO START EVALDEFINE
ASG ; PRODUCTION TO START ASSIGNC
NMC ; PRODUCTION TO START INHIBITION OF MACRO
; EXPANSION
ERF ; PRODUCTION TO START EVALREDEFINE
↑PARSE: ;THIS IS THE PARSER !
MOVE TEMP,PCSAV ; GET PRODUCTION CONTROL STACK POINTER
; *** DCS CHANGED 11-30-71
PARSIT: SKIPGE PROD,(TEMP) ; GET PRODUCTION
JRST (PROD) ; PRODUCTION IS CODE, NOT INTERPRETED
; CURRENTLY USED ONLY TO RETURN AFTER DONES
; *** DCS
HRRZ PROD,(PROD) ;PICK UP SUCCESS POINTER
IFN FTDEBUG <SETZM DEBTEM>
SKIPA C,[XWD 0,-1] ;REGISTER FOR CLASS COMPARE TEST AND START
FAIL: HLRZ PROD,(PROD) ;GET FAILURE POINTER
PROGO: IFN FTDEBUG <
;;#GH# DCS 2-1-72 (3-5) USE INTERRUPTS FOR ASYNCH BREAKS
AOS PROCNT ;COUNT NUMBER OF PRODUCTIONS LOOKED AT
↑PRODBK: JRST DUMPRO ;CHECK FOR PRODUCTION BREAK OR INTERRUPT
>
POOG: HRLZI PTR,(<POINT 12,0>) ;INITIALIZE BYTE POINTER
HRRI PTR,1(PROD) ;MORE BYTE POINTER
HRRZ PP,PPSAV ;MOVE PARSE STACK POINTER INTO PP FOR USE
COMMENT ⊗ Compare Loop⊗
COMP: ILDB A,PTR ;PICK UP FIRST BYTE
TRNE A,BCLASS!BCARE!BDONE ;REGULAR COMPARE?
JRST NOREG ;NO
IFN FTCOUNT, <AOS REGCNT>
CAME A,(PP) ;COMPARE BYTE TO STACK
JUMPN A,FAIL ;GO TO FAILURE PRODUCTION UNLESS "SIGMA"
SOJA PP,COMP ;LOOP
NOREG: TRZE A,BCLASS ;CLASS COMPARE?
JRST CLASSCOM ;YES
TRZN A,BCARE ;CAREFUL COMPARE?
JRST POPTEM ;DONE WITH COMPARES
CARE: HRRZ B,(PP) ;GET ONLY ID NUMBERS FROM STACK
IFN FTCOUNT,<AOS CARCNT>
CAIE B,(A) ;COMPARE TOKEN AGAINST BYTE
JRST FAIL ;BAD COMPARE
SOJA PP,COMP
CLASSCOM:
CAML C,(PP) ;LOOK TO SEE IF CLASS INDEX IS ON
JRST FAIL ;NO -- STACK ENTRY WAS NOT CLASS MEMBER
MOVEI CLSIDX,CLSTAB ;PREPARE THE INDEX REGISTER FOR TDNE@
TRZE A,400 ;ON IF CLASS NUMBER GREATER THAN 36.
MOVEI CLSIDX,CLSTAB+CLASSNO ;OTHER CLASS TABLE.
MOVE B,BITAB-1(A) ;MAGIC BIT FOR THIS CLASS NUMBER.
IFN FTCOUNT, < AOS CLSCNT >
TDNE B,@(PP) ;SEE IF CLSTAB HAS THE BIT ON
SOJA PP,COMP ;YES -- GO ON
JRST FAIL ;NO
COMMENT ⊗ Pop to Temps, Do Execs⊗
;POP OFF TOP OF STACK INTO TEMPORARIES. THIS IS TO KEEP STACKS
;(GENERATOR AND PARSE) IN SYNC, AND KEEP EXEC ROUTINES FROM
;CLOBBERING THEM.
POPTEM: HRRZ C,PPSAV ;COMPUTE NUMBER OF THINGS TO POP.
SUBI C,(PP) ;OK, READY TO GO.
IFN FTDEBUG,<MOVEM C,DEBTEM>
MOVE GP,GPSAV ;PICK UP STACK POINTERS
MOVE PP,PPSAV
SETZM B ;ZERO THE INITIAL COUNTER
POPA: SOJL C,RESTA ;DONE POPPING ?
POP GP,GENLEF(B) ;POP GENERATOR ENTRY
POP PP,PARLEF(B)
AOJA B,POPA ;NOT DONE YET
RESTA: MOVEI B,-BDONE(A) ;TAKE ACCOUNT OF BIT.
MOVEM B,TEMCNT ;COUNT OF RIGHT HALF TEMPORARIES.
RESTB: ILDB A,PTR ;GET NEXT BYTE FROM TABLE
JUMPE B,EXECA
TRZE A,BTEMP ;RESTORE FROM TEMPORARY ?
JRST RESTMP ;YES
CAIGE A,CLASSNO ;RESTORE WITH CLASS INDEX?
TLO A,CLSIDX ;YES
MOVEM A,PARRIG-1(B) ;STORE IN RIGHT HALF TEMPORARY
MOVE C,GENLEF-1(B) ;SEMANTICS ARE COPIED FOR SAKE OF
MOVEM C,GENRIG-1(B) ;CONVENIENCE FOR T SG (rgt arrows) E SG
SOJA B,RESTB ;GO FOR MORE
RESTMP: MOVE C,PARLEF-1(A) ;GET THE TEMP. FROM THE LEFT STORAGE
MOVEM C,PARRIG-1(B) ;AREA AND PUT IT IN THE RIGHT ONE.
MOVE C,GENLEF-1(A)
MOVEM C,GENRIG-1(B) ;
SOJA B,RESTB ;LOOP UNTIL DONE.
;CALL ANY EXECUTIVE ROUTINES THAT ARE NEEDED. THE TABLE
;EXCTAB, LISTING ALL ROUTINES, IS PUT TOGETHER BY THE
;PRODUCTION TABLE ASSEMBLER.
EXECA: MOVE TEMP,PCSAV ; GET PRODUCTION CONTROL STACK POINTER
MOVEM PROD,(TEMP) ; SAVE PRODUCTION POINTER
MOVEM PP,PPSAV ;SAVE PARSE STACK POINTER
MOVEM GP,GPSAV ;AND GENERATOR STACK POINTER
EXECB: TRZE A,BDONE ;DONE ?
JRST REST ; YES -- RESTORE STACKS.
TRZE A,BCLASS ;CLASS TYPE ROUTINE?
JRST EXCLS
TRZE A,BCARE ;INDEX SPECIFIED DIRECTLY?
JRST EXIND
EXGO: PUSH P,PTR
IFN FTDEBUG <
AOS EXCCNT ;COUNT # EXECS SEEN
;; #GH# (3) CONT
↑EXCBK: SKIPE PTR,.DBG. ;ANY CHANCE OF BREAK?
JRST DMYEXC ; YES, CALL THE DEBUG PACKAGE >
EXDO: XCT EXCTAB-1(A) ;CALL THE ROUTINE WITH GENCLS IN B
EXDON: POP P,PTR ;RESTORE THE WORLD
ILDB A,PTR ;GET NEXT BYTE
JRST EXECB ;TRY AGAIN
EXCLS: HRRZ B,PARLEF-1(A)
ILDB A,PTR ;A NOW HAS AN INDEX UNTO THE CLASS
SUB B,A ;B HAS THE RELATIVE INDEX
ILDB A,PTR ;NOW INDEX TO ROUTINE
JRST EXGO ;GO DO THE ROUTINE
EXIND: MOVE B,A ;THE INDEX IS SPECIFIED EXPLICITLY
ILDB A,PTR
JRST EXGO ;GO DO IT
COMMENT ⊗ Restore Stack, Scan⊗
;RESTORE THE STACKS FROM THE TEMPORARIES.
;CALL THE SCANNER THE RIGHT NUMBER OF TIMES, AND
;GO START ALL OVER AGAIN.
REST: MOVE GP,GPSAV
MOVE PP,PPSAV
SKIPN B,TEMCNT
JRST SCANA
RES1: PUSH PP,PARRIG-1(B) ;RESTORE PARSE ITEM.
PUSH GP,GENRIG-1(B) ;AND SEMANTIC ITEM.
SOJN B,RES1 ;GO BACK FOR MORE.
SCAN1: MOVEM PP,PPSAV ;SAVE STACK POINTERS
MOVEM GP,GPSAV ;SAVE STACK POINTERS
SCANA: MOVE TEMP,PCSAV ;
ADDI PTR,1 ; PTR POINTS TO PUSHJ ADDRESS
PUSH TEMP,PTR ; ASSUME PUSHJ
TRNE A,BCARE ; CHECK FOR A POPJ WHICH NEEDS TO RESTORE SCNNO.
TRNE A,BPRESUME ; SCNNO AND DOESN'T INVOLVE A PARSER SWITCH
JRST SCAN2 ; NO
HLRE B,-2(TEMP) ; THIS IS THE CASE WHEN ONE HAS AN INTERRUPTED
JUMPLE B,SCAN2 ; PRODUCTION (I.E. DEFINE) WHICH IS TO BE
TRZ A,BCARE+BCLASS ; RESUMED. JUMPLE BECAUSE OF [-1,RELSE]
ADD A,B ; AT BOTTOM OF STACK. RESTORE FLAGS. POPJ
SUB TEMP,X22 ; PRIORITY OVER PUSHJ IF BOTH ARE SPECIFIED
SCAN2: MOVEM A,SCNNO ; NUMBER OF SCANS TO DO
MOVEM TEMP,PCSAV ; SAVE PRODUCTION CONTROL STACK POINTER
DPUSH: TRNN A,777 ; ANY SCANS TO DO?
JRST DOIT ; NO, GO DO PUSH, POP, OR NOTHING
TRZE A,BPRESUME ; PARSER SWITCH?
JRST[TRZE A,BCARE ; YES, POPJ?
JRST[SUB TEMP,X22 ; YES, SET PCSAV STRAIGHT
MOVEM TEMP,PCSAV ;
MOVE TEMP,SCWSV ; POP SCNWRD STACK
SUB TEMP,X11 ;
MOVEM TEMP,SCWSV ;
JRST DPSHED] ;
DPSHED: SKIPE PRSCON ; DETERMINE WHICH PARSER ONE IS CURRENTLY IN AND
SKIPA TEMP,[CGPSAV-1] ; GET THE ADDRESS TO SAVE ITS PARSER DESCRIPTOR.
MOVEI TEMP,SGPSAV-1 ; SAVE SEMANTIC STACK POINTER, PARSE STACK
PUSH TEMP,GPSAV ; POINTER, CONTROL STACK POINTER, AND A POINTER
PUSH TEMP,PPSAV ; TO THE SCNWRD STACK.
PUSH TEMP,PCSAV ;
MOVE TBITS2,SCNWRD ; SAVE SCNWRD
MOVE B,SCWSV ;
MOVEM TBITS2,(B) ;
PUSH TEMP,SCWSV ;
SKIPE PRSCON ; DETERMINE WHICH PARSER IS TO BE RESUMED AND GET
SKIPA TEMP,[XWD -1,SSCWSV] ; THE ADDRESS OF ITS PARSER DESCRIPTOR.
HRROI TEMP,CSCWSV ;
POP TEMP,SCWSV ; RESTORE SCNWRD AND SCNWRD STACK POINTER
MOVE B,SCWSV ;
MOVE TBITS2,(B) ;
MOVEM TBITS2,SCNWRD ;
POP TEMP,PCSAV ; RESTORE CONTROL STACK POINTER
MOVE B,PCSAV ;
HLRZ B,(B) ;
MOVEM B,SCNNO ; RESTORE NUMBER TO SCAN
POP TEMP,SP ; RESTORE PARSE STACK POINTER. MUST BE IN AC AS
MOVEM SP,PPSAV ; WELL AS IN MEMORY.
POP TEMP,GPSAV ; RESTORE SEMANTIC STACK POINTER
SETCMM PRSCON ; SET PARSER IN CONTROL
JRST .+1]
PUSHJ P,SCANNER ; GO SCAN
;;#GH# (3-5) END
IFN FTDEBUG, <
AOS SCNCNT ; COUNT CALLS ON SCANNER
SKIPGE PTR,.DBG. ; PERHAPS WANT TO BREAK?
PUSHJ P,DUMSCN ; YES, GO HANDLE
>;IF FTDEBUG
;;#GH# (3-5)
SOS A,SCNNO ; DECREMENT SCAN COUNT
JRST DPUSH ; AND LOOP
DOIT: TRNE A,BCLASS ; IF PUSHJ, THEN
JRST PARSE ; ALL DONE
MOVE TEMP,PCSAV ; RESTORE PRODUCTION CONTROL STACK POINTER
SUB TEMP,X11 ; PUSHJ ASSUMPTION WAS WRONG
TRNE A,BCARE ; POPJ?
SUB TEMP,X11 ; YES, POP PRODUCTION CONTROL STACK
MOVEM TEMP,PCSAV ; SAVE PRODUCTION CONTROL STACK POINTER
JRST PARSIT ; CONTINUE
COMMENT ⊗Timer Package⊗
IFN TIMER, <
BEGIN TIMER
COMMENT ⊗
THIS IS A LITTLE TIMER THAT WORKS FOR SAIL.
IF YOU START THE THING AT "TIMIT", THE COMPILER WILL
BE INTERPRETED. COUNTS OF THE GENERAL TYPE OF INSTRUCTION
(IN INTAB) AND WHERE (IN THE BUCKETS DEFINED BY THE MACRO
RR AT THE END) ARE KEPT. USING THIS ROUTINE SLOWS COMPILATION
DOWN BY A FACTOR OF ROUGHLY 25.
⊗
EXTERNAL JOBSA
;AC'S
ZZ ← 0 ;CRUCIAL IN NUMBERS.
AA ← 1 ; DITTO.
↑TIMIT: ;START HERE
SETZM INTAB
MOVE ZZ,[XWD INTAB,INTAB+1]
BLT ZZ,INTAB+7
MOVEI ZZ,BKLEN ;NUMBER OF BUCKETS IN TABLE.
MOVEI AA,BKBEG ;FIRST BUCKET.
BKLOP: SETZM 1(AA) ;COUNT OF INSTRUCTIONS IN BUCKET.
ADDI AA,2
SOJG ZZ,BKLOP ;LOOP......
HRRZ AA,JOBSA ;WHERE TO START !!
MOVEM AA,PPCNT
MOVEM AA,PEECEE ;MY PROGRAM COUNTER
SEARCH: MOVEM 3,SAV3
MOVEM ZZ,ZZSAV ;GET SOME AC'S
MOVEM 4,SAV4
MOVEI ZZ,BKLEN
MOVEI 3,BKBEG ;PREPARE TO SEARCH BLOCK.
COMLUP: HLRZ 4,(3) ;LOWER BOUND
CAIGE AA,(4) ;ABOVE IT
JRST NOFAIL
HRRZ 4,(3)
CAILE AA,(4) ;AND UNDER IT.
JRST NOFAIL
HRRZM 4,CURTOP
HLRZ 4,(3)
HRRZM 4,CURBOT
MOVEI 3,1(3) ;PLACE WHERE COUNT IS
MOVEM 3,CURPNT
ALLON: MOVE 3,SAV3
MOVE 4,SAV4
MOVE ZZ,ZZSAV
JRST STARUP ;GO GO GO
NOFAIL: ADDI 3,2
SOJG ZZ,COMLUP ;LOOK SOME MORE
JRST ALLON ;IF YOU CAN'T FIND A NEW BUCKET, USE
;OLD ONE.
DOIT: MOVE AA,AASAV
INST: XCT @PPCNT ;MOST INSTR'S EXECUTED HERE.
JRST NEXT ;DID NOT SKIP
AOS PEECEE
NEXT: MOVEM AA,AASAV
RECORD: SETZM XCTF ;EXECUTE GOING ?
MOVE AA,PEECEE ;PC ← MA
MOVEM AA,PPCNT
RECGO: CAML AA,CURBOT ;SEE IF EFFECTIVE ADDRESS IN THIS
CAMLE AA,CURTOP ;BUCKET ...
JRST SEARCH ;NOT IN THIS BUNCH.
STARUP: CAMN AA,PROGS ;BREAK POINT
TIMBRK: JFCL ;PLACE TO PLANT A REAL DDT BREAKPOINT
AOS @CURPNT ;INDEX THE BUCKET COUNTER
LDB AA,[POINT 3,@PPCNT,2] ;INSTRUCTION
SKIPN XCTF
AOS PEECEE ;PC ← PC +1
AOS INTAB(AA) ;RECORD INSTRUCTION FREQUENCY
JRST @DISTAB(AA)
INTAB: BLOCK 10
DISTAB: UUOINST ;DISPATCH TABLE
DOIT
SPECL
JUMPS
DOIT
DOIT
DOIT
DOIT
UUOINST:
LDB AA,[POINT 9,@PPCNT,8]
CAIE AA,41 ;INIT ?
JRST DOIT
ERR <INIT'S ARE NOT USED IN SAIL>
JUMPS: LDB AA,[POINT 6,@PPCNT,5] ;INTERPRET JUMPS
CAIN AA,32
JRST JUMPXX
CAIE AA,34
CAIN AA,36
SKIPA
JRST DOIT
JUMPXX: MOVE AA,@PPCNT
TLZ AA,37
HLLM AA,JMPINS ;SAVE IT.
MOVE AA,AASAV
JMPINS: JRST TRA ;GO TO TRA IF IT TAKES.
JRST NEXT ;DID NOT TAKE.
TRA: MOVEM AA,AASAV
MOVEM ZZ,ZZSAV
TRAIT:
MOVE ZZ,@PPCNT
MOVEI ZZ,@ZZ ;DEPENDS ON ZZ BEINO ZERO.
MOVEM ZZ,PEECEE ;NEW VALUE
MOVE AA,ZZ
MOVE ZZ,ZZSAV
JRST RECORDIT
SPECL: LDB AA,[POINT 9,@PPCNT,8]
TRCE AA,30
TRNN AA,40
JRST DOIT
TRCN AA,30
JRST DOIT
TRNN AA,10
JRST DPUSHJ ;OP CODES 260 - 267
CAIE AA,256 ;XCT
JRST [CAILE AA,251
JRST JUMPXX
JRST DOIT]
SETOM XCTF ;START EXECUTE CYCLE
MOVEM ZZ,ZZSAV
MOVE ZZ,@PPCNT
MOVE AA,AASAV
MOVEI ZZ,@ZZ ;EFFECTIVE ADDRESS....
MOVEM ZZ,PPCNT
MOVE AA,ZZ
MOVE ZZ,ZZSAV
JRST RECGO
DPUSHJ: MOVEM ZZ,ZZSAV
ANDI AA,7
JRST @.+1(AA)
PUSHJ1
DOIT
DOIT
POPJ1
JSR1
JSP1
JSA1
JRA1
PUSHJ1: MOVE ZZ,PEECEE
LDB AA,[POINT 4,@PPCNT,12]
DPB AA,[POINT 4,.+3,12]
EXCH ZZ,ZZSAV
MOVE AA,AASAV
PUSH ZZSAV
JRST TRA
POPJ1: LDB AA,[POINT 4,@PPCNT,12]
DPB AA,[POINT 4,.+2,12]
MOVE AA,AASAV
POP PEECEE
MOVEM AA,AASAV
HRRZS AA,PEECEE
JRST RECORDIT
JSR1: MOVE ZZ,@PPCNT
MOVE AA,AASAV
MOVEI ZZ,@ZZ
MOVE AA,PEECEE
MOVEM AA,@ZZ
AOS AA,ZZ
MOVEM AA,PEECEE
MOVE ZZ,ZZSAV
JRST RECORDIT
JSP1: LDB AA,[POINT 4,@PPCNT,12]
MOVE ZZ,PEECEE
MOVEM ZZ,ZZSAV(AA) ;RECORD IN BOTH PLACES.
MOVEM ZZ,(AA)
JRST TRAIT
JSA1: JRA1:
ERR <NOT IMPLEMENTED>
PPCNT: 0
CURTOP: 0
CURBOT: 0
ZZSAV: 0
AASAV: 0
BLOCK 20
SAV3: 0
SAV4: 0
XCTF: 0
PEECEE: 0
CURPNT: 0
PROGS: 0
BKLEN ←=12
BKBEG:
DEFINE RR (BEGINNING,ENDD) < XWD BEGINNING,ENDD
0
>
RR LARGER,PRODGO ;COMMAND SCANNER & INITIALIZATION
RR PARSE,<POPTEM-1>;PRODUCTION SEARCHER
RR POPTEM,TIMIT-1 ;STACK POPPER & EXEC ROUTINE CALLER
RR BKBEG,<SCAN-1> ;DEBUGGING ROUTINES
RR SCAN,<ENTER-1> ;SCANNER ...
RR ENTER,<GENINI-1>;SYMBOL TABLE LOOKUP & ENTER
RR GENINI,<LEPINI-1>;HIGH LEVEL ARITHMETIC GENERATORS
RR LEPINI,<CONV-1>;HIGH LEVEL LEAP GENERATORS
RR CONV,RINGSORT-1 ;LOW LEVEL GENERATORS
RR RINGSORT,PATCH ;CORE MANAGEMENT, STRING GARBAGE COLLECTOR
RR 400000,777777 ;CORE MANAGEMENT, STRING GARBAGE COLLECTOR
BLOCK =2
BEND
>
>;TEMPORARY END OF IFN FTDEBUG
SUBTTL Debug package.
COMMENT ⊗Debugging Package -- Description
Here begins the debugging package.
These routines provide parse/semantic information at selected points
during a compilation. This display can be obtained when:
1. A production is about to be tried
2. An Exec routine is about to be called
3. A token has just been scanned
4. A selected line has been reached (or on every line)
5. <esc>I is typed (Stanford only) -- after next Token scan
Information displayed is:
1. The current file, page, and line number.
2. The current input line, with a line-feed inserted to indicate
the position of the Scanner.
3. The current macro being expanded, if any, same format.
4. The reason for the break.
5. The top few elements of the parse/semantics stacks, including:
a) @ if the token is a member of some class
b) The symbolic name of the token in the parse stack (e.g., TLPRN)
c) The address of any Semblk associated with that token.
d) Two Fields, the TBITS word from that Semblk, in octal.
e) The left-half SBITS word in octal.
f) The ACNO field, in octal.
g) A few characters from the name (string value) of the entity, if any.
The break routine then prints "#" and waits for directives, which may be:
B Breakpoint operation. Must be followed by "s" (set) or "r"
(remove) then the production name, followed by a space.
xxM Set Mode. Must be preceded by a number xx :
1. Break only when execs are about to be called.
2. Break only on <esc>I or line break or production breakpoint.
3. Break on all productions and execs.
4. Break as specified in current breakpoint mode, but don't pause
for directives -- terminated by <esc>I break or line break
5 Continuously display the line being scanned (Stanford III only)
6 Break after each call on SCANNER (no automatic stack display).
C Count the free storage cells.
nnP Proceed. If nn is present, no actual breaks will occur until nn
opportunities to do so (of any kind, excluding <esc>I) have
presented themselves. PROCNT, EXCCNT, SCNCNT, LINCNT are counts of
the number of productions, execs, etc., seen so far.
D Go to DDT or RAID -- operates by setting a breakpoint if using RAID,
return with <ctrl>P. In DDT, return by REGO$G. Returns to debug
loop, types "#", awaits command.
L Stop on selected line -- followed by line/page, compiler will stop
just after reading specified line, but before processing it. If /page
is omitted, current one is implied. Other commands may follow this
one on the line, but a <crlf> is required to activate the commands.
If the file has no SOS line numbers, use the ordinality of the line
in the current page.
xxS Show the xx'th stack entry (0 is top) in the above format.
T Terminate and return to error handler (if you came from there).
This whole section of code is merely a convenience, and not really part of
the guts of the compiler. Most of the routines were written to satisfy
real debugging needs as the compiler was being developed.
⊗
COMMENT ⊗ Variables⊗
ZERODATA (PARSE DEBUGGER VARIABLES)
COMMENT ⊗
PRODUCTION/EXEC BREAK CONTROL VARIABLES
.DBG. -- This value is set by the /M switch in the command line,
or by the M parameter in the Debugging Scanner. Its values,
corresponding "M" codes, and functions are ---
0 -- /2M -- Do not break on anything but "asynchronous break"
(user types CR to break in)
>0 -- /3M -- Break when EXEC routine to be executed
<0 -- /1M -- Break when any production matches, or on EXEC
/5M and /6M cut .DBG. out of the loop.
⊗
↑↑.DBG.: 0
;;#GH# DCS 2-1-72 (4-5) ADD 6M SCANNER BREAK, INTERRUPT FOR ASYNCH BREAKS
?SCNBRK: 0 ;TEMP USED IN DMY TO INDICATE SCANNER BREAK
↑↑SCBCNT: 0 ;USED IN DMY AS REPEAT COUNT FOR ANY BREAK
↑↑PROCNT: 0 ;NUMBER OF TIMES THROUGH THE PRODUCTION DEBUGGER (DPY OR NOT)
↑↑EXCCNT: 0 ;NUMBER OF TIMES THROUGH THE EXEC DEBUGGER
↑↑SCNCNT: 0 ;NUMBER OF TIMES THROUGH THE SCAN BREAK ROUTINE
↑↑LINCNT: 0 ;NUMBER OF LINE BREAKS
;BREAKP -- set if DMY is being executed because of a production
; breakpoint -- see DSCR for debug routines for more details
?BREAKP: 0
;EXC -- set before DMY is called -- 0 if PRODUCTION Break,
; -1 if EXEC break (unless SCNBRK set, then irrelevant)
?EXC: 0
;MULTP -- set if user is not to be given control after input
; line, stack, etc. are displayed (subject to INTERRUPT, of
; course (/4M mode)
↑↑MULTP: 0
;PLINSW -- set if input line is to be displayed at every possible
; moment (/5M mode)
↑↑PLINSW: 0
COMMENT ⊗
OTHER DEBUGGER VARIABLES, RICH AND POOR
IFN FTDEBUG < ;JUST CONDIT THE BIG ONES
ACSAV -- block for saving ACs when doing DMY
⊗
?ACSAV: BLOCK 20
>
;; #GH# (4) REMOVE ASYNTMP
?ASAV: 0 ;SAVE AC A SOMETIMES
COMMENT ⊗
BKR -- specifies break character for ASCFIL routine -- see for
details (used to allow ASCII strings to be considered as
single entities at one time, for shipping around, later
as groups of characters, to be interspersed with other data
e.g., setting up title lines, printing display line, etc.
⊗
↑↑BKR: 0
?CHAR: 0 ;TEMP FOR DEBUGGER SCANNER
IFN FTDEBUG <
COMMENT ⊗
DDFBUF, DDFPDL, DDRES
Variables for implementing the DDFIND routine -- called from
RAID or DDT to find the Semantics currently corresponding
to a name.
⊗
?DDFBUF: BLOCK 6 ;FOR INPUT OF ID
?DDFPDL: BLOCK 13 ;SPECIAL PDP
↑↑DDRES: 0 ;RESULT IF FOUND
;DDFPDP -- SEE ALSO, BELOW
>
?DEBTEM: 0 ;A TEMP
COMMENT ⊗
EXROUTIN -- A call to the desired EXEC is placed here before
going into the debugging business -- at an appropriate
point, after the stack has been displayed, and the user
has had a chance to respond (he can look at EXROUTIN, among
other things), this is XCTed -- not used if not debugging
⊗
↑↑EXROUTIN: 0
;FILBP -- PNEXTC transferred here when macro expansion is entered.
; Used to print arrow on input line display (see ASCFIL)
↑↑FILBP: 0 ;CONSIDER PUTTING THIS ELSEWHERE
?HIRAN: 0 ;RANDOM TEMP
?LSTPSW: 0 ;FLAG INDICATING LINE # BREAK TO DMY
?NEG: 0 ;RANDOM FLAG FOR NUMBER INPUTTER IN DEBUG SCANNER
?SENC: 0 ;RANDOM TEMP
?SETB: 0 ;RANDOM TEMP
?STLINE: 0 ;LINE # (ASCII) ON WHICH TO CAUSE LINE BREAK
↑↑STPAGE: 0 ;PAGE # (BINARY) ON WHICH TO CAUSE LINE BREAK
DATA (PARSE DEBUGGER VARIABLES)
IFN FTDEBUG <
COMMENT ⊗
HEADINGS FOR DEBUG OUTPUT (DESCRIBES REASON FOR BREAK, ETC.)
⊗
;; #GH# (4) USED TO BE ASYNBUF
↑↑SCNBUF: ASCIZ "SCANNER BREAK
"
↑↑HBUF: ASCIZ "PRODUCTION IS "
↑↑HDBUF: ASCIZ "LINE BREAK
"
↑↑XBUF: ASCIZ "EXEC ROUTINE "
?DDFPDP: IOWD 12,DDFPDL ;PDP FOR DDFPDL (SEE DDRES)
;OBUF -- Output buffer for TTYUUO'S to type stack info
OBUF: ASCII/ /
BLOCK 10
;;#GR# DCS 2-8-72 (2-3) MINOR FTDEBUG FIXES
↑PRSBP: 0 ;-1 IF BP SET AT BRKHER (FOR D COMMAND)
;;#GR# (2)
>
ENDDATA
COMMENT ⊗ Stplin -- Break on <crlf>⊗
IFN FTDEBUG, < ;RESUME CONDITIONAL ASSEMBLY
↑STPLIN:PUSH P,A
SETOM LSTPSW ;DO NOT PRINT HEADER FOR STACK
MOVE A,STPAGE ;WANTS TO STOP ON THIS PAGE NUM
JUMPE A,STPTHS ;EACH PAGE?
CAME A,FPAGNO ;HAS IT COME BY YET?
JRST LSTPJ ; (THERE WILL BE FILE REDUNDANCY)
MOVE A,STLINE ;RIGHT PAGE, IS IT THE
CAME A,ASCLIN ; DESIRED LINE?
JRST LSTPJ ;NO
STPTHS: SOSLE SCBCNT ;STOP YET?
JRST LSTPJ ;NOPE
SETZM EXC ;CLEAR USELESS PARAMS
SETZM DEBTEM
PUSHJ P,DMY
LSTPJ: SETZM LSTPSW ;RESET
POP P,A
POPJ P,
COMMENT ⊗ Dmyexc, etc. -- Main Control Loops⊗
EXTERNAL JOBDDT
;; #GH# (4) .DBG.= -1,,-1 OR 0,,-1 FOR EXEC BREAK,
;; #GH# -1,,-1 FOR PRODUCTION BREAK,
;; #GH# 400000,,-1 FOR SCANNER BREAK,
;; #GH# 400000,,377777 FOR <ESC>I BREAK
DMYEXC:JUMPGE PTR,DOXC ;ALWAYS BREAK IF GTR. 0 (NOT SCAN OR ASYN BREAK)
TLNN PTR,200000 ;SCAN BREK?
JRST EXDO ;YES, IGNORE .DBG. COMPLETELY
DOXC: SOSLE SCBCNT ;SHOW IT YET?
JRST EXDO ;NO
PUSH P,EXCTAB-1(A) ;THE EXEC ROUTINE
POP P,EXROUTIN
SETOM EXC
MOVEM A,ASAV
PUSHJ P,DMY
XCT EXROUTIN ;DO IT IF NECESSARY.
JRST EXDON
DUMPRO: MOVE A,-1(PROD) ;PICK UP PRODUCTION NAME
SETZM BREAKP
SETZM EXC
MOVEM A,ASAV
SKIPL PTR,.DBG. ;A STANDARD BREAK?
JRST CHKBKP ; NO, CHECK PRODUCTION BREAKPOINT
TLNN PTR,200000 ;PERHAPS A SCANNER BREAK?
JRST POOG ; YES, IGNORE
JRST YESPRO ;GO DISPLAY
CHKBKP: TRNN A,1 ;A BREAKPOINT ?
JRST POOG ;NO
SETOM BREAKP ;YES
YESPRO: SOSLE SCBCNT ;TIME TO QUIT?
JRST POOG ;NO, AND AFTER ALL THAT, TOO!
PUSHJ P,DMY
JRST POOG
DUMSCN:
NOEXPO <
TRNE PTR,400000 ;WAS IT AN <ESC>I INTERRUPT?
JRST NOINTR ; NO
SETZM .DBG. ; YES, DON'T LET IT HAPPEN AGAIN
SETZM MULTP
JRST INTR
>;NOEXPO
NOINTR: TLNN PTR,200000 ;IS IT A SCAN BREAK?
SOSLE SCBCNT ;AND HAVE WE DONE ENOUGH OF THEM?
POPJ P, ; NO, PRODUCTION OR KEEP UP -- NEXT TIME
INTR: SETOM SCNBRK
PUSHJ P,DMY
SETZM SCNBRK
POPJ P, ;DO IT
COMMENT ⊗ Dmy -- Inna, Inn --Display Subroutine⊗
DMY: MOVEM 0,ACSAV
MOVE 0,[XWD 1,ACSAV+1]
BLT 0,ACSAV+16 ;SAVE ALL ACCUMULATORS
PUSHJ P,DSPLIN ;DISPLAY IF POSSIBLE
SETZM CHAR ;CHARACTER COUNTER
MOVEI A,HDBUF
SKIPE LSTPSW ;LINE NUMBER BREAK?
JRST PRTHED ;YES, PRINT SIMPLE HEADING
;; #GH# (4)
MOVEI A,SCNBUF
SKIPE SCNBRK
JRST PRTHED
;;#GH# (4-5) END
MOVE PTR,[POINT 7,HBUF+3]
SKIPE EXC ;CALLED FROM EXECUTIVE HANDLER?
HRRI PTR,XBUF+3 ;YES
MOVE A,ASAV ;GET SIXBIT OR PTR TO IT BACK
SKIPE EXC
MOVE A,EXCNAM(A) ;GET EX NAME
PUSHJ P,PRNSM ;PRINT THE SYMBOL
PUSHJ P,CRLF
MOVEI A,HBUF
SKIPE EXC
MOVEI A,XBUF
PRTHED:
CALL6 (A,DDTOUT) ;USED TO BE A CALL
SKIPE SCNBRK ;DON'T VOLUNTEER STACK ON SCANNER
JRST GO.ON ; BREAK
MOVEI A,0
MOVE B,DEBTEM
ADDM B,GPSAV
ADDM B,PPSAV
P6: PUSH P,A
PUSH P,B
SETZM CHAR
PUSHJ P,PRINLIN
POP P,B
POP P,A
SOS A
SOJE B,P6A
SKIPE EXC
JRST .+4
CAME A,[-3]
JRST P6
JRST P6A
MOVN C,A
CAME C,DEBTEM
JRST P6
P6A: MOVN B,DEBTEM
ADDM B,PPSAV
ADDM B,GPSAV
GO.ON: SKIPN LSTPSW ;STOP ON LINE BREAK ALWAYS
SKIPN MULTP ;IN MULTIPLE PROCEED?
JRST INNA ;NO
SKIPN BREAKP
JRST PRO ;PROCEED IF NO BREAKPOINT.
;;#GR# DCS 2-8-72 (3-3) MINOR FTDEBUG MODS
↑↑INNA: SETZB C,NEG
INSKIP A ;ANY CHARS WAITING?
OUTCHR ["#"] ;NO, TYPE WAITING MESSAGE
INN: TTCALL A ;GET A CHAR FROM USER
; let debugger know about lower case
CAIE A,"p"
CAIN A,"P"
JRST PROXX ;PROCEED
CAIE A,"d"
CAIN A,"D" ;GO TO DDT
JRST DDTG
CAIE A,"b"
CAIN A,"B" ;BREAKPOINT
JRST BP1
CAIE A,"t"
CAIN A,"T"
POPJ P, ;RETURN TO ERROR HANDLER
CAIE A,"s"
CAIN A,"S" ;STACK EXAMINE.
JRST STA
CAIE A,"m"
CAIN A,"M" ;MODE
JRST MOD1
CAIE A,"c"
CAIN A,"C" ;COUNT
JRST SCNT
CAIE A,"l"
CAIN A,"L" ;PAGE AND LINE BREAK SPECS?
JRST LINSTOP ; YES
NOEXPO <
CAIE A,"q"
CAIN A,"Q" ;SET A BREAKPOINT?
JRST SETONE ; YES
CAIE A,"r"
CAIN A,"R" ;REMOVE A BREAKPOINT?
JRST REMONE ; YES
>;NOEXPO
CAIE A,"-"
JRST [CAIG A,"9"
CAIGE A,"0"
JRST INN
IMULI C,=10
ADDI C,-"0"(A)
JRST INN]
SETOM NEG
JRST INN
STA:
SKIPL NEG
MOVNS C ;WE WERE TOLD TO COMPLEMENT IT
MOVE A,C
ADD A,DEBTEM ;TO GET INREASONABLE RANGE.
PUSHJ P,PRINLIN
JRST INNA
BP1: TTCALL A
CAIE A,"s"
CAIN A,"S" ;SET?
SETOM SETB
CAIE A,"r"
CAIN A,"R"
SETZM SETB
SETZB B,SENC
MOVE C,[POINT 6,B]
BPX: TTCALL A
SUBI A,40 ;CONVERT TO SIXBIT
SKIPN SENC
JUMPE A,BPX
IDPB A,C
SETOM SENC
JUMPN A,BPX
MOVEM B,HIRAN
MOVEI A,BB0-1 ;START HERE
FLOP: CAIN A,IPROC ;END HERE
JRST NOFND
MOVE C,(A)
TRZ C,1 ;TRUN OFF DEBUG BIT.
CAMN C,B
JRST YESFND
AOJA A,FLOP
COMMENT ⊗ Read L/P⊗
LINSTOP: ;GET LINE/PAGE NUMBERS
TTCALL 14,0 ;WAIT FOR ACTIVATOR
SETZM STLINE
;;#GG# DCS 2-1-72 (1-2) ASSUME CURRENT PAGE
MOVEW STPAGE,FPAGNO ;ASSUME CURRENT PAGE
;;#GG#
MOVE TEMP,[POINT 7,STLINE]
MOVEI B,5 ;MAX USABLE COUNT
LSLP10: TTCALL A ;GET A CHAR
CAIL A,"0"
CAILE A,"9" ;IS IT A DIGIT?
JRST LSLP10 ;NO
SKIPA ;YES
LSLP1: TTCALL A ;GET A CHAR
CAIL A,"0"
CAILE A,"9" ;DIGIT?
JRST LSLP2 ;NO, DONE
SOJL B,LSLP1 ;FORGET AFTER 5
IDPB A,TEMP ;PUT IT AWAY
JRST LSLP1 ;LOOP
LSLP2: MOVE B,STLINE ;GET RESULT
LSLP3: TRNE B,376 ;LOW ORDER 0?
AOJA B,LSLP4 ;NO, ALL OK
LSH B,-7
TLO B,"0"⊗(=18-7) ;YES, PUT IN ZEROES
JRST LSLP3 ;LOOP UNTIL ALL ASCII CHARS
LSLP4: MOVEM B,STLINE ;RESTORE IT
CAIE A,"/" ;PAGE # SPECIFIED?
JRST INNA ;NO
MOVEI B,0 ;YES, GET PAGE #
LSLP6: TTCALL A ;GET A CHAR
CAIL A,"0"
CAILE A,"9" ;DIGIT?
JRST LSLP5 ; YES, DONE
IMULI B,=10
ADDI B,-"0"(A) ;COLLECT NUMBER
JRST LSLP6 ;LOOP
LSLP5: MOVEM B,STPAGE
JRST INNA ;DONE
;;#GG# DCS 2-1-72 (2-2)
CCPP: SKIPGE TEMP,STPAGE ;USE PAGE 1 IF NO PAGE YET
MOVEI TEMP,1
MOVEM TEMP,STPAGE
;;#GG#
NOFND: TERPRI <NOT FOUND>
JRST INNA
YESFND: SKIPE SETB
TRO C,1
MOVEM C,(A) ;PUT IT BACK.
JRST INNA
MOD1:
JUMPL C,INNA
CAIG C,6
;DCS 9-21-71
PUSHJ P,STMD ;(SEE COMMAND SCANNER)
JRST INNA
NOEXPO <
SETONE: SKIPE EXC ;IF CALLED FROM EXEC HANDLER,
PUSHJ P,SETBKP ; SET A BREAKPOINT
JRST INNA ;NEXT COMMAND
REMONE: SKIPE EXC
PUSHJ P,REMBKP ;REMOVE IF FOUND
JRST INNA ;FORGET IT IF NOT
>;NOEXPO
SCNT: SETZM C
SKIPA LPSA,BLFREE
SLOPP: RIGHT ,%TBUCK,ALDD
AOJA C,SLOPP
ALDD: OCTPNT C
JRST INNA
;Ddtg, Rego, Proxx -- Enter, Leave DDT, Proceed from Debug
;; #GR# (3)
DDTG: SKIPN A,JOBDDT
JRST INNA ;NO DDT
TLNE A,40 ;RAID VERSION 1?
JRST PRODD ; YES, CAUSE A BREAKPOINT
EXCH A,(P) ;NEW ADDRESS.
;;%##% USED TO BE HRRZM
HRRM A,REGO ;WHERE TO CONTINUE
JRST PRO ;CONTINUE
PROXX: TTCALL 11, ;CLEAR INPUT BUFFER BEFORE PROCEEDING
MOVEM C,SCBCNT ;REPEAT FACTOR FOR SCANNER BREAK
PRO: MOVE 0,[XWD ACSAV+1,1]
BLT 0,16
MOVE 0,ACSAV
POPJ P, ;DONE
↑↑REGO: JRST .
PRODD: MOVE A,-6(A) ;ADR OF $I
MOVEM A,PRSBP ;STORE OUT OF ACS
MOVE 0,[XWD ACSAV+1,1];GET 'EM BACK TEMPORARILY
BLT 0,16
MOVE 0,ACSAV
↑↑BRKHER:JSR @PRSBP ;BREAK HERE
JRST INNA ;AWAY WE GO
;;#GR# (3)
COMMENT ⊗ Prinlin -- Print Stack Entry Line⊗
;ROUTINE TO PUT TOGETHER A LINE ABOUT THE STACK ENTRY
;WHOSE INDEX IS IN REGISTER "A"
PRINLIN:MOVEM A,ASAV
MOVE B,PPSAV
ADDI B,(A)
MOVE B,(B) ;STACK ENTRY
MOVEI C,"@"
CAIG B,400000
MOVEI C," "
DPB C,[POINT 7,OBUF,27] ;CLASS TYPE?
MOVE A,SYMNAM (B) ;PRINT NAME
MOVE PTR,[POINT 7,OBUF+1]
PUSHJ P,PRNSM
MOVE PTR,[POINT 7,OBUF+2,27]
MOVE B,GPSAV
ADD B,ASAV
MOVE A,(B)
PUSH P,A ;GENERATOR ENTRY
PUSHJ P,NUM
PUSHJ P,SPOUT
MOVE D,(P) ;IS THERE AN ENTRY?
CAMGE D,LPSTOP
CAMGE D,LPSBOT
PING: JRST CRLF0
HLRZ A,$TBITS(D)
PUSHJ P,NUM
PUSHJ P,SPOUT
HRRZ A,$TBITS(D) ;TBITS
PUSHJ P,NUM
PUSHJ P,SPOUT
HLRZ A,$SBITS(D)
PUSHJ P,NUM
PUSHJ P,SPOUT
HRRZ A,$ACNO(D)
PUSHJ P,NUM
PUSHJ P,SPOUT
HRRZ A,$PNAME(D) ;COUNT
JUMPE A,CRLF0 ;NO PRINT NAME
CAILE A,15
MOVEI A,15
HLRZ TEMP,$PNAME+1(D)
CAIE TEMP,(<POINT 7,0>)
JRST CRLF0
MOVE D,$PNAME+1(D)
SRFF: ILDB TEMP,D
IDPB TEMP,PTR
SOJG A,SRFF
CRLF0: POP P,A
TRZ C,177
IDPB C,PTR
TTCALL 3,OBUF ;PRINT THE LINE
TERPRI ;TERMINATE IT
POPJ P,
CRLF: MOVEI C,15
IDPB C,PTR
MOVEI C,12
IDPB C,PTR
TRZ C,177
IDPB C,PTR
POPJ P,
SPOUT: MOVEI TEMP," "
IDPB TEMP,PTR
POPJ P,
Comment ⊗ DDFIND -- find symbol for USER.
Called from DDT or RAID by typing DDFIND$G ⊗
↑DDFIND: EXCH P,DDFPDP ;IN CASE RAID IS DISHONEST
PUSHJ P,SAVE ;IN GOGOL.IOSER
;; JRL- DDFIND SHOULDN'T DESTROY TEMP,LPSA, OR USER EITHER
PUSH P,TEMP
PUSH P,LPSA
PUSH P,USER
;;
SETZM DDFBUF
MOVE TEMP,[XWD DDFBUF,DDFBUF+1] ;CLEAR BUFFER
BLT TEMP,DDFBUF+5
MOVEI A,0 ;COLLECT COUNT
PUSH P,PNAME
PUSH P,PNAME+1
MOVE B,[POINT 7,DDFBUF]
MOVEM B,PNAME+1 ;FIRST BYTE OF PNAME
DDF1: TTCALL TEMP ;GET A CHARACTER
CAIN TEMP,15 ;TERMINATES
JRST DDFDUN
IDPB TEMP,B ;YES
AOJA A,DDF1 ;GET IT ALL
DDFDUN: HRRZM A,PNAME ;COUNT
PUSH P,HPNT
PUSH P,NEWSYM
MOVE LPSA,SYMTAB
PUSHJ P,SHASH
SKIPE A,NEWSYM
TERPRI <FOUND IT -- RESULTS IN DDRES>
SKIPN A
TERPRI <NOT FOUND>
MOVEM A,DDRES
POP P,NEWSYM
POP P,HPNT
POP P,PNAME+1
POP P,PNAME
;; -RESTORE WHAT WE SAVED
POP P,USER
POP P,LPSA
POP P,TEMP
;;
MOVEI LPSA,0
MOVEI TEMP,.+3
MOVEM TEMP,UUO1(USER)
JRST RESTR
EXCH P,DDFPDP
POPJ P, ;SINCE HE CALLED IT WITH PUSHJ P,
NUM: MOVNI C,6
ROT A,=18
PEP2: SETZM B
ROTC A,3
ADDI B,"0"
IDPB B,PTR
AOS CHAR
AOJN C,PEP2
POPJ P,
SIXBT: MOVNI C,3
P3: SETZM B
ROTC A,6
ADDI B,40
IDPB B,PTR
AOS CHAR
AOJN C,P3
POPJ P,
NOEXPO <
EXTERNAL JOBDDT
↑SETBKP:
PUSH P,A
HRRZ TEMP,EXROUTINE ;PNTS TO ADDR TO BE BREAKPOINTED
SKIPE A,JOBDDT ;IS DDT LOADED?
JSR TEMP,@-1(A) ; YES, SET THE BREAKPOINT
; THERE IS A DISPATCH TO A BREAKPOINT-SETTING ROUTINE HERE IN RAID ONLY
APOPJ: POP P,A
POPJ P,
↑REMBKP:
PUSH P,A
HRRZ TEMP,EXROUTINE
SKIPE A,JOBDDT ;DDT (RAID) LOADED?
JSR TEMP,@-2(A) ; YES, REMOVE BREAKPOINT
JRST APOPJ
>;NOEXPO
↑PRNSM: PUSHJ P,PRINSYM ;PRINT THE SYMBOL
MOVEI B," " ;FINISH OUT WITH SPACES
JUMPGE C,PRSP1
LLX: IDPB B,PTR
AOS CHAR
AOJN C,LLX
POPJ P,
> ;end of IFN FTDEBUG conditional assmby.
COMMENT ⊗Decfil, Ascfil, Prinsym⊗
DSCR DECFIL
CAL PUSHJ from text-line creators
PAR D is number to be converted to ASCII
TEMP is ASCII bp to output
RES ASCII for D (with sign, if neg) is deposited via TEMP
SID D, D+1 destroyed, TEMP updated
⊗
↑DECFIL: ; PUT A POSITIVE NUMBER IN ASCII IN BUFFER
; POINTED TO BY TEMP
JUMPGE D,POSFIL ;MIGHT BE NEGATIVE
MOVEI D+1,"-"
IDPB D+1,TEMP
MOVMS D ;ISN'T NOW
POSFIL: IDIVI D,=10
HRLM D+1,(P) ;IT'S RECURSIVE PRINTER TIME AGAIN
SKIPE D
PUSHJ P,POSFIL
HLRZ D,(P)
IORI D,"0"
IDPB D,TEMP
POPJ P,
DSCR ASCFIL
CAL PUSHJ from routines which create text lines
PAR A is input BP
BKR is break char
TEMP is output BP
FILBP (in compiler) is bp to a char which is to be indicated
by an arrow. (via DPY instrs if NOEXPO, LF otherwise).
RES Text is moved from A's area to TEMP's, stopping when
an input char = BKR (or if BKR<0, when char terminates line).
If A ever = FILBP, stuff is done to produce the arrow or line
feed (assumes that when this happens, output is going to DPY).
SID B is destroyed, A and TEMP are updated.
⊗
↑ASCFIL:CAME A,FILBP
JRST NOARROW ;NOT YET (OR NOT AGAIN)
MOVEI B,12
IDPB B,TEMP ;NO, USE LINE FEED TO
NOARROW:
ILDB B,A
SKIPGE BKR
JRST [JUMPE B,YPOPJ ;IN THIS MODE, WANT TO
CAIE B,177 ;STOP ON 0, 12, OR 177
CAIN B,12
POPJ P,
JRST FDIPB]
CAMN B,BKR ;DONE?
YPOPJ: POPJ P,
FDIPB: IDPB B,TEMP ;NO -- STORE THIS ONE
JRST ASCFIL
; SIXBIT INPUT IN A
; USES B,C
; OUTPUT TO PTR'S BYTE POINTER
; MODIFIES CHAR
↑↑PRINSYM:
MOVNI C,6 ;COUNT
PRSP1: SETZM B
ROTC A,6
JUMPE B,PRSP2
ADDI B,40 ;CONVERT TO ASCII
IDPB B,PTR
AOS CHAR
AOJN C,PRSP1
PRSP2: POPJ P,
XALL
↑PRSYM: PUSH P,C ;KVL SEZ: THIS MUST BE FOR USE WITH DDT
HRRZ C,$PNAME(LPSA) ;PRINT SYMBOL IN LPSA
MOVE A,$PNAME+1(LPSA)
JRST PRTST
PRLOP: ILDB B,A ;GET CHAR
PUUO 1,B ;PRINT IT
PRTST: SOJGE C,PRLOP
POP P,C
POPJ P,
SUBTTL Production Tables.